home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4th86_v4.zip / HILSIER2.4TH < prev    next >
Text File  |  1993-03-30  |  3KB  |  136 lines
  1.  
  2. 2 block n
  3. ( 2 n ! )
  4. ( 2 ' n 3 + @ b!)
  5.  
  6. 512 const h0
  7. 7 const maxcolr
  8. 2 block colr
  9. 2 block ii
  10. 2 block hh
  11. 2 block x
  12. 2 block y
  13. 2 block x00
  14. 2 block y00
  15. 2 block mag
  16.  
  17. : incx x @ hh @ + x ! ;
  18. : decx x @ hh @ - x ! ;
  19. : dec2x x @ hh @ 2 * - x ! ;
  20. : inc2x x @ hh @ 2 * + x ! ;
  21. : incy y @ hh @ + y ! ;
  22. : decy y @ hh @ - y ! ;
  23. : dec2y y @ hh @ 2 * - y ! ;
  24. : inc2y y @ hh @ 2 * + y ! ;
  25. : plot x @ y @ colr @ dline ;
  26. : hplot x @ 2 / y @ 2 / colr @ dline ;
  27. : setplot x @ y @ 0 dline ;
  28. : hsetplot x @ 2 / y @ 2 / 0 dline ;
  29.  
  30. : aa0 ;
  31. : bb0 ;
  32. : cc0 ;
  33. : dd0 ;
  34.  
  35. : AA dup 0> if
  36.      1- DD0 decx plot 
  37.      1- recurse decy plot     
  38.      1- recurse incx plot
  39.      1- BB0 then 1+ ;
  40.  
  41. : BB dup 0> if
  42.      1- CC0 incy plot 
  43.      1- recurse incx plot     
  44.      1- recurse decy plot
  45.      1- AA0 then 1+ ;
  46.  
  47. : CC dup 0> if
  48.      1- BB0 incx plot 
  49.      1- recurse incy plot     
  50.      1- recurse decx plot
  51.      1- DD0 then 1+ ;
  52.  
  53. : DD1 dup 0> if
  54.      1- AA0 decy plot 
  55.      1- recurse decx plot     
  56.      1- recurse incy plot
  57.      1- CC0 then 1+ ;
  58.  
  59. link aa0 aa link bb0 bb      link cc0 cc   link dd0 dd1
  60.  
  61. : swcolr
  62.        colr @ 1+ maxcolr /mod drop dup 0= if 1+ then colr ! ;
  63.  
  64. : hilb 0 colr !
  65.  
  66.        egam   ( depth case 0 of 1 mag ! 5 n ! endof
  67.                         1 of 1 mag ! n ! endof
  68.                         2 of mag ! n ! endof endcase  )
  69.  
  70.      1 mag ! 7 ( 5 ) n ! 
  71.  
  72.      0 ii !  h0  8 / hh !  hh @ 2 / 19 * dup 5 / 70h + x00 !  5 / 40h + y00 ! 
  73.  h0 2 / mag @ * hh !  ( modified hilb)
  74.  
  75.     begin  swcolr
  76.        ii @ 1+ ii !  
  77.        hh @ 2 / hh ! 
  78.     x00 @ hh @ 2 / + x00 !
  79.         y00 @ hh @ 2 / + y00 !
  80.        x00 @ x !  y00 @ y ! setplot 
  81.     ii @ AA drop
  82.     n @ ii @ - 0= end ;
  83.  
  84. : aax0 ;
  85. : bbb0 ;
  86. : ccc0 ;
  87. : ddd0 ;
  88.  
  89. : AAX dup 0> if
  90.      1- recurse incx decy hplot 
  91.      1- BBB0 inc2x hplot     
  92.      1- DDD0 incx incy hplot
  93.      1- recurse then 1+ ;
  94.  
  95. : BBB dup 0> if
  96.      1- recurse decx decy hplot 
  97.      1- CCC0 dec2y hplot     
  98.      1- AAX0 incx decy hplot
  99.      1- recurse then 1+ ;
  100.  
  101. : CCC dup 0> if
  102.      1- recurse decx incy hplot 
  103.      1- DDD0 dec2x hplot     
  104.      1- BBB0 decx decy hplot
  105.      1- recurse then 1+ ;
  106.  
  107. : DDD1 dup 0> if
  108.      1- recurse incx incy hplot 
  109.      1- AAX0 inc2y hplot     
  110.      1- CCC0 decx incy hplot
  111.      1- recurse then 1+ ;
  112.  
  113. link aax0 aax link bbb0 bbb      link ccc0 ccc   link ddd0 ddd1
  114.  
  115. : sierp 0 colr !
  116.         egam ( depth case 0 of 1 mag ! 5 n ! endof
  117.                         1 of 1 mag ! n ! endof
  118.                         2 of mag ! n ! endof endcase )
  119.  
  120.       1 mag ! 7 ( 5 ) n ! 
  121.  
  122.      0 ii !  h0 8 / hh !  hh @ 19 * dup 4 / 140h + x00 !  5 / afh + y00 ! 
  123. h0 4 ( 8 ) / mag @ * hh !
  124.     begin  swcolr
  125.        ii @ 1+ ii !   x00 @ hh @ - x00 !  
  126.        hh @ 2 / hh !  y00 @ hh @ + y00 !
  127.        x00 @ x !  y00 @ y !  hsetplot 
  128.        ii @ AAX incx decy hplot drop
  129.        ii @ BBB decx decy hplot drop 
  130.        ii @ CCC decx incy hplot drop
  131.        ii @ DDD1 incx incy hplot drop
  132.  
  133.     n @ ii @ - 0= end ;
  134.  
  135.  
  136.